在 Excel 中发现区分大小写的重复项时如何删除整行(对于 100k 条记录或更多)?
How to delete entire row when case sensitive duplicates are found in Excel (for 100k records or more)?
这是 如何删除 Excel 中区分大小写的重复项(对于 100k 或更多记录)的后续问题?
。
由于他的代码程序只处理 A 列的数据,我还想删除整行数据 如果区分大小写 找到重复项。
Case sensitive meaning:
- Case1
- case1
- cASE1
Are all unique records.
您可以使用 Dictionary
检查二进制唯一性和变体数组以加快速度。要使用字典,您需要包含对 Microsoft Scripting Runtime Library
的引用
(工具 > 参考 > Microsoft 脚本运行时库)
我在我的 笔记本电脑 .
上测试了 100,000 行,平均需要 0.25 秒
Sub RemoveDuplicateRows()
Dim data As Range
Set data = ThisWorkbook.Worksheets("Sheet1").UsedRange
Dim v As Variant, tags As Variant
v = data
ReDim tags(1 To UBound(v), 1 To 1)
tags(1, 1) = 0 'keep the header
Dim dict As Dictionary
Set dict = New Dictionary
dict.CompareMode = BinaryCompare
Dim i As Long
For i = LBound(v, 1) To UBound(v, 1)
With dict
If Not .Exists(v(i, 1)) Then 'v(i,1) comparing the values in the first column
tags(i, 1) = i
.Add Key:=v(i, 1), Item:=vbNullString
End If
End With
Next i
Dim rngTags As Range
Set rngTags = data.Columns(data.Columns.count + 1)
rngTags.Value = tags
Union(data, rngTags).Sort key1:=rngTags, Orientation:=xlTopToBottom, Header:=xlYes
Dim count As Long
count = rngTags.End(xlDown).Row
rngTags.EntireColumn.Delete
data.Resize(UBound(v, 1) - count + 1).Offset(count).EntireRow.Delete
End Sub
基于
的精彩回答
这是 如何删除 Excel 中区分大小写的重复项(对于 100k 或更多记录)的后续问题? 。
由于他的代码程序只处理 A 列的数据,我还想删除整行数据 如果区分大小写 找到重复项。
Case sensitive meaning:
- Case1
- case1
- cASE1
Are all unique records.
您可以使用 Dictionary
检查二进制唯一性和变体数组以加快速度。要使用字典,您需要包含对 Microsoft Scripting Runtime Library
(工具 > 参考 > Microsoft 脚本运行时库)
我在我的 笔记本电脑 .
上测试了 100,000 行,平均需要 0.25 秒Sub RemoveDuplicateRows()
Dim data As Range
Set data = ThisWorkbook.Worksheets("Sheet1").UsedRange
Dim v As Variant, tags As Variant
v = data
ReDim tags(1 To UBound(v), 1 To 1)
tags(1, 1) = 0 'keep the header
Dim dict As Dictionary
Set dict = New Dictionary
dict.CompareMode = BinaryCompare
Dim i As Long
For i = LBound(v, 1) To UBound(v, 1)
With dict
If Not .Exists(v(i, 1)) Then 'v(i,1) comparing the values in the first column
tags(i, 1) = i
.Add Key:=v(i, 1), Item:=vbNullString
End If
End With
Next i
Dim rngTags As Range
Set rngTags = data.Columns(data.Columns.count + 1)
rngTags.Value = tags
Union(data, rngTags).Sort key1:=rngTags, Orientation:=xlTopToBottom, Header:=xlYes
Dim count As Long
count = rngTags.End(xlDown).Row
rngTags.EntireColumn.Delete
data.Resize(UBound(v, 1) - count + 1).Offset(count).EntireRow.Delete
End Sub
基于